home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / find.tcl.z / find.tcl
Text File  |  2002-07-08  |  6KB  |  247 lines
  1. # find.tcl
  2. #
  3. # Find tool.
  4. #
  5. # Copyright (c) 1993 Xerox Corporation.
  6. # Use and copying of this software and preparation of derivative works based
  7. # upon this software are permitted. Any distribution of this software or
  8. # derivative works must comply with all applicable United States export
  9. # control laws. This software is made available AS IS, and Xerox Corporation
  10. # makes no warranty about the software, its performance or its conformity to
  11. # any specification.
  12.  
  13. proc Find_Msg {} {
  14.     global find
  15.     set find(choice) Msg
  16.     Find_Setup
  17. }
  18. proc Find_FTOC {} {
  19.     global find
  20.     set find(choice) FTOC
  21.     Find_Setup
  22. }
  23. proc Find_Setup {} {
  24.     global find findSettings
  25.  
  26.     Find_Reset
  27.     if [Exwin_Toplevel .find "Exmh Find Tool" Find] {
  28.     set t .find
  29.     set f $t.but    ;# from Exwin_Toplevel
  30.  
  31.     Widget_AddBut $f next "Next" {Find_It forw} {left padx 1 filly}
  32.     Widget_AddBut $f prev "Prev" {Find_It prev} {left padx 1 filly}
  33.     set find(allbut) [Widget_CheckBut $f all "All" find(all) {left padx 1}]
  34.     Widget_RadioBut $f ftoc "FTOC" find(choice) {left padx 1}
  35.     Widget_RadioBut $f msg "Msg" find(choice) {left padx 1}
  36.  
  37.     set f [Widget_Frame $t rim Rim]
  38.     $f configure -bd 10
  39.     set f [Widget_Frame $f rim LabelledEntry]
  40.     Widget_Label $f label {left fill} -text "Pattern: "
  41.     set find(entry) [Widget_Entry $f entry {right fill expand}]
  42.     Bindings_Search $find(entry)
  43.  
  44.     if {![info exists find(choice)] || $find(choice) == ""} {
  45.             set find(choice) $findSettings(defaultLoc)
  46.         }
  47.  
  48.     trace variable find(choice) w FindTraceChoice
  49.     FindTraceChoice
  50.     if ![info exists find(all)] {
  51.         set find(all) 0
  52.     }
  53.     } else {
  54.     $find(entry) delete 0 end
  55.     }
  56.     focus $find(entry)
  57. }
  58. proc FindTraceChoice {args} {
  59.     global find
  60.     catch {
  61.     if {$find(choice) == "FTOC"} {
  62.     $find(allbut) config -state normal
  63.     } else {
  64.     $find(allbut) config -state disabled
  65.     }
  66.     }
  67. }
  68. proc Find_Reset {} {
  69.     global find
  70.     set find(dir) forw
  71.     set find(line) 1
  72.     set find(lasthit) {}
  73.     set find(wrap) 0
  74.     set find(wrapLine) 1
  75.     catch {unset find(curline)}
  76. }
  77. proc FindDestroy {} {
  78.     global find
  79.     set find(geometry) [wm geometry .find]
  80.     wm withdraw .find
  81.     Exmh_Focus
  82. }
  83. proc Find_It { {dir _default_} } {
  84.     global find
  85.     if ![info exists find(entry)] {
  86.     Find_Setup
  87.     return
  88.     }
  89.     if [catch {$find(entry) configure}] {
  90.     unset find(entry)
  91.     Find_Setup
  92.     return
  93.     }
  94.     if {[wm state .find] != "normal"} {
  95.     global exwin
  96.     catch {wm geometry .find $exwin(geometry,$path)}
  97.     wm deiconify .find
  98.     Find_Setup
  99.     return
  100.     } else {
  101.     catch {raise .find}
  102.     }
  103.     if {$dir == "_default_"} {
  104.     Find_Reset
  105.     set dir forw
  106.     }
  107.     set find(dir) $dir
  108.     if {$find(choice) == "FTOC"} {
  109.     global ftoc
  110.     if {$find(all)} {
  111.         Ftoc_FindAll [$find(entry) get]
  112.     } else {
  113.         Find_Inner [$find(entry) get] $dir $ftoc(curLine) $ftoc(numMsgs) Ftoc_FindMatch
  114.     }
  115.     return
  116.     }
  117.     if {$find(choice) == "Msg"} {
  118.         global exwin
  119.     set last [lindex [split [$exwin(mtext) index end] .] 0]
  120.     incr last -1
  121.     Find_Inner [$find(entry) get] $dir $find(line) $last Msg_FindMatch
  122.     return
  123.     }
  124. }
  125. proc Find_Inner { string dir start max matchProc {feedback yes} } {
  126.     global exwin find
  127.     set verbose [expr {$feedback == "yes"}]
  128.     if {[string length $string] == 0} {
  129.     if {$verbose} {Exmh_Status "No search string" warn}
  130.     return -1
  131.     }
  132.     if {$find(wrap)} {
  133.     set find(line) $find(wrapLine)
  134.     } else {
  135.     set find(line) $start
  136.     }
  137.     if {$find(line) == {}} {
  138.     set find(line) 1
  139.     }
  140.     set L $find(line)
  141.     Exmh_Debug "Find_Inner line $L max $max wrap $find(wrap) wline $find(wrapLine)"
  142.     if {$dir == "forw"} {
  143.     for { } {$L <= $max} {incr L} {
  144.         switch -- [FindMatch $matchProc $L $string] {
  145.         -1 { return 0 }
  146.         1  {
  147.             set find(wrap) 0
  148.             return 1    ;# find(line) has been updated
  149.         }
  150.         }
  151.     }
  152.     if {! $find(wrap)} {
  153.         set find(wrap) 1
  154.         set find(wrapLine) 1
  155.         if {$verbose} {Exmh_Status "Find miss: <Control-s> to wrap" warn}
  156.         return 0
  157.     }
  158.     set find(wrap) 0
  159.     for {set L 0} {$L < $find(line)} {incr L} {
  160.         switch -- [FindMatch $matchProc $L $string] {
  161.         -1 { return 0 }
  162.         1  {
  163.             set find(wrap) 0
  164.             return 1    ;# find(line) has been updated
  165.         }
  166.         }
  167.     }
  168.     } else {
  169.     for { } {$L >= 1} {incr L -1} {
  170.         switch -- [FindMatch $matchProc $L $string] {
  171.         -1 { return 0 }
  172.         1  {
  173.             set find(wrap) 0
  174.             return 1    ;# find(line) has been updated
  175.         }
  176.         }
  177.     }
  178.     if {! $find(wrap)} {
  179.         set find(wrap) 1
  180.         set find(wrapLine) $max
  181.         if {$verbose} {Exmh_Status "Find miss: <Control-r> to wrap" warn}
  182.         return 0
  183.     }
  184.     set find(wrap) 0
  185.     for {set L $max} {$L > $find(line)} {incr L -1} {
  186.         switch -- [FindMatch $matchProc $L $string] {
  187.         -1 { return 0 }
  188.         1  {
  189.             set find(wrap) 0
  190.             return 1    ;# find(line) has been updated
  191.         }
  192.         }
  193.     }
  194.     }
  195.     if {$verbose} {Exmh_Status "No match" warn}
  196.     return -1
  197. }
  198. proc FindMatch { hook L string } {
  199.     global find
  200.     if [catch {$hook $L $string} match] {
  201.     Exmh_Status "$match"
  202.     return -1
  203.     }
  204.     if {$match == 1} {
  205.     set find(line) $L
  206.     # HACK
  207.     if {! [string match Sedit* $hook]} {
  208.         Exmh_Focus
  209.         Exmh_Status "Find hit: <Control-s> next, <Control-r> prev" 
  210.     }
  211.     }
  212.     return $match
  213. }
  214. proc FindTextMatch {t L string} {
  215.     global find
  216.     if [$t compare $L.end >= end] {
  217.     return -1
  218.     }
  219.     if [catch {$t get $L.0 $L.end} text] {
  220.     return -1
  221.     }
  222.     if {$L == $find(lasthit)} {
  223.     # Look for more strings on the same line
  224.     # This behaves wrong during Previous searches...
  225.     set text [string range $text $find(lastchar2) end]
  226.     } else {
  227.     set find(lastchar2) 0
  228.     }
  229.     if {[regexp -nocase -indices $string $text match]} {
  230.     global msg
  231.     set range [$t tag ranges sel]
  232.     if {$range != {}} {
  233.         eval {$t tag remove sel} $range
  234.     }
  235.     set char1 [expr $find(lastchar2)+[lindex $match 0]]
  236.     set char2 [expr $find(lastchar2)+[lindex $match 1]+1]
  237.     $t tag add sel $L.$char1 $L.$char2
  238.     $t tag raise sel
  239.     WidgetTextYview $t -pickplace $L.$char1
  240.     set find(lasthit) $L
  241.     set find(lastchar2) $char2
  242.     return 1
  243.     }
  244.     return 0
  245. }
  246.  
  247.